home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / FROMUTS / XLISP1 / !XLisp / c / XLREAD < prev    next >
Text File  |  1990-02-24  |  16KB  |  745 lines
  1. /* xlread - xlisp expression input routine */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. #ifdef MEGAMAX
  9. overlay "io"
  10. #endif
  11.  
  12. /* external variables */
  13. extern NODE *s_stdout,*true,*s_dot;
  14. extern NODE *s_quote,*s_function,*s_bquote,*s_comma,*s_comat;
  15. extern NODE *s_rtable,*k_wspace,*k_const,*k_nmacro,*k_tmacro;
  16. extern NODE ***xlstack;
  17. extern int xlplevel;
  18. extern char buf[];
  19.  
  20. /* external routines */
  21. extern FILE *fopen();
  22. extern double atof();
  23. extern ITYPE;
  24.  
  25. #define WSPACE "\t \f\r\n"
  26. #define CONST1 "!$%&*+-./0123456789:<=>?@[]~_{}~"
  27. #define CONST2 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
  28.  
  29. /* forward declarations */
  30. FORWARD NODE *callmacro();
  31. FORWARD NODE *phexnumber(),*pquote(),*plist(),*pvector(),*pname();
  32. FORWARD NODE *tentry();
  33.  
  34. /* xlload - load a file of xlisp expressions */
  35. int xlload(fname,vflag,pflag)
  36.   char *fname; int vflag,pflag;
  37. {
  38.     NODE ***oldstk,*fptr,*expr;
  39.     char fullname[STRMAX+1];
  40.     CONTEXT cntxt;
  41.     FILE *fp;
  42.     int sts;
  43.  
  44.     /* create a new stack frame */
  45.     oldstk = xlsave(&fptr,&expr,(NODE **)NULL);
  46.  
  47. #ifdef Risc
  48.     /* RisOS files do not have extensions so don't bother with them */
  49. #else
  50.     /* create the full file name */
  51.     if (needsextension(fname)) {
  52.     strcpy(fullname,fname);
  53.     strcat(fullname,".lsp");
  54.     fname = fullname;
  55.     }
  56. #endif
  57.  
  58.     /* allocate a file node */
  59.     fptr = cvfile(NULL);
  60.  
  61.     /* print the information line */
  62.     if (vflag)
  63.     { sprintf(buf,"; loading \"%s\"\n",fname); stdputstr(buf); }
  64.  
  65.     /* open the file */
  66.     if ((fp = fopen(fname,"r")) == NULL) {
  67.     xlstack = oldstk;
  68.     return (FALSE);
  69.     }
  70.     setfile(fptr,fp);
  71.  
  72.     /* read, evaluate and possibly print each expression in the file */
  73.     xlbegin(&cntxt,CF_ERROR,true);
  74.     if (setjmp(cntxt.c_jmpbuf))
  75.     sts = FALSE;
  76.     else {
  77.     while (xlread(fptr,&expr,FALSE)) {
  78.         expr = xleval(expr);
  79.         if (pflag)
  80.         stdprint(expr);
  81.     }
  82.     sts = TRUE;
  83.     }
  84.     xlend(&cntxt);
  85.  
  86.     /* close the file */
  87.     fclose(getfile(fptr));
  88.     setfile(fptr,NULL);
  89.  
  90.     /* restore the previous stack frame */
  91.     xlstack = oldstk;
  92.  
  93.     /* return status */
  94.     return (sts);
  95. }
  96.  
  97. /* xlread - read an xlisp expression */
  98. int xlread(fptr,pval,rflag)
  99.   NODE *fptr,**pval; int rflag;
  100. {
  101.     int sts;
  102.  
  103.     /* reset the paren nesting level */
  104.     if (!rflag)
  105.     xlplevel = 0;
  106.  
  107.     /* read an expression */
  108.     while ((sts = readone(fptr,pval)) == FALSE)
  109.     ;
  110.  
  111.     /* return status */
  112.     return (sts == EOF ? FALSE : TRUE);
  113. }
  114.  
  115. /* readone - attempt to read a single expression */
  116. int readone(fptr,pval)
  117.   NODE *fptr,**pval;
  118. {
  119.     NODE *val,*type;
  120.     int ch;
  121.  
  122.     /* get a character and check for EOF */
  123.     if ((ch = xlgetc(fptr)) == EOF)
  124.     return (EOF);
  125.  
  126.     /* handle white space */
  127.     if ((type = tentry(ch)) == k_wspace)
  128.     return (FALSE);
  129.  
  130.     /* handle symbol constituents */
  131.     else if (type == k_const) {
  132.     *pval = pname(fptr,ch);
  133.     return (TRUE);
  134.     }
  135.  
  136.     /* handle read macros */
  137.     else if (consp(type)) {
  138.     if ((val = callmacro(fptr,ch)) && consp(val)) {
  139.         *pval = car(val);
  140.         return (TRUE);
  141.     }
  142.     else
  143.         return (FALSE);
  144.     }
  145.  
  146.     /* handle illegal characters */
  147.     else
  148.     xlerror("illegal character",cvfixnum((FIXNUM)ch));
  149.     /*NOTREACHED*/
  150. }
  151.  
  152. /* rmhash - read macro for '#' */
  153. NODE *rmhash(args)
  154.   NODE *args;
  155. {
  156.     NODE ***oldstk,*fptr,*mch,*val;
  157.     int ch;
  158.  
  159.     /* create a new stack frame */
  160.     oldstk = xlsave(&fptr,&mch,&val,(NODE **)NULL);
  161.  
  162.     /* get the file and macro character */
  163.     fptr = xlgetfile(&args);
  164.     mch = xlmatch(INT,&args);
  165.     xllastarg(args);
  166.  
  167.     /* make the return value */
  168.     val = consa(NIL);
  169.  
  170.     /* check the next character */
  171.     switch (ch = xlgetc(fptr)) {
  172.     case '\'':
  173.         rplaca(val,pquote(fptr,s_function));
  174.         break;
  175.     case '(':
  176.         rplaca(val,pvector(fptr));
  177.         break;
  178.     case 'x':
  179.     case 'X':
  180.             rplaca(val,phexnumber(fptr));
  181.         break;
  182.     case '\\':
  183.         rplaca(val,cvfixnum((FIXNUM)xlgetc(fptr)));
  184.         break;
  185.     default:
  186.         xlerror("illegal character after #",cvfixnum((FIXNUM)ch));
  187.     }
  188.  
  189.     /* restore the previous stack frame */
  190.     xlstack = oldstk;
  191.  
  192.     /* return the value */
  193.     return (val);
  194. }
  195.  
  196. /* rmquote - read macro for '\'' */
  197. NODE *rmquote(args)
  198.   NODE *args;
  199. {
  200.     NODE ***oldstk,*fptr,*mch,*val;
  201.  
  202.     /* create a new stack frame */
  203.     oldstk = xlsave(&fptr,&mch,&val,(NODE **)NULL);
  204.  
  205.     /* get the file and macro character */
  206.     fptr = xlgetfile(&args);
  207.     mch = xlmatch(INT,&args);
  208.     xllastarg(args);
  209.  
  210.     /* make the return value */
  211.     val = consa(NIL);
  212.     rplaca(val,pquote(fptr,s_quote));
  213.  
  214.     /* restore the previous stack frame */
  215.     xlstack = oldstk;
  216.  
  217.     /* return the value */
  218.     return (val);
  219. }
  220.  
  221. /* rmdquote - read macro for '"' */
  222. NODE *rmdquote(args)
  223.   NODE *args;
  224. {
  225.     NODE ***oldstk,*fptr,*mch,*val;
  226.     int ch,i,d1,d2,d3;
  227.  
  228.     /* create a new stack frame */
  229.     oldstk = xlsave(&fptr,&mch,&val,(NODE **)NULL);
  230.  
  231.     /* get the file and macro character */
  232.     fptr = xlgetfile(&args);
  233.     mch = xlmatch(INT,&args);
  234.     xllastarg(args);
  235.  
  236.     /* loop looking for a closing quote */
  237.     for (i = 0; i < STRMAX && (ch = checkeof(fptr)) != '"'; i++) {
  238.     switch (ch) {
  239.     case '\\':
  240.         switch (ch = checkeof(fptr)) {
  241.         case 'f':
  242.             ch = '\f';
  243.             break;
  244.         case 'n':
  245.             ch = '\n';
  246.             break;
  247.         case 'r':
  248.             ch = '\r';
  249.             break;
  250.         case 't':
  251.             ch = '\t';
  252.             break;
  253.         default:
  254.             if (ch >= '0' && ch <= '7') {
  255.                 d1 = ch - '0';
  256.                 d2 = checkeof(fptr) - '0';
  257.                 d3 = checkeof(fptr) - '0';
  258.                 ch = (d1 << 6) + (d2 << 3) + d3;
  259.             }
  260.             break;
  261.         }
  262.     }
  263.     buf[i] = ch;
  264.     }
  265.     buf[i] = 0;
  266.  
  267.     /* initialize the node */
  268.     val = consa(NIL);
  269.     rplaca(val,cvstring(buf));
  270.  
  271.     /* restore the previous stack frame */
  272.     xlstack = oldstk;
  273.  
  274.     /* return the new string */
  275.     return (val);
  276. }
  277.  
  278. /* rmbquote - read macro for '`' */
  279. NODE *rmbquote(args)
  280.   NODE *args;
  281. {
  282.     NODE ***oldstk,*fptr,*mch,*val;
  283.  
  284.     /* create a new stack frame */
  285.     oldstk = xlsave(&fptr,&mch,&val,(NODE **)NULL);
  286.  
  287.     /* get the file and macro character */
  288.     fptr = xlgetfile(&args);
  289.     mch = xlmatch(INT,&args);
  290.     xllastarg(args);
  291.  
  292.     /* make the return value */
  293.     val = consa(NIL);
  294.     rplaca(val,pquote(fptr,s_bquote));
  295.  
  296.     /* restore the previous stack frame */
  297.     xlstack = oldstk;
  298.  
  299.     /* return the value */
  300.     return (val);
  301. }
  302.  
  303. /* rmcomma - read macro for ',' */
  304. NODE *rmcomma(args)
  305.   NODE *args;
  306. {
  307.     NODE ***oldstk,*fptr,*mch,*val,*sym;
  308.  
  309.     /* create a new stack frame */
  310.     oldstk = xlsave(&fptr,&mch,&val,(NODE **)NULL);
  311.  
  312.     /* get the file and macro character */
  313.     fptr = xlgetfile(&args);
  314.     mch = xlmatch(INT,&args);
  315.     xllastarg(args);
  316.  
  317.     /* check the next character */
  318.     if (xlpeek(fptr) == '@') {
  319.     sym = s_comat;
  320.     xlgetc(fptr);
  321.     }
  322.     else
  323.     sym = s_comma;
  324.  
  325.     /* make the return value */
  326.     val = consa(NIL);
  327.     rplaca(val,pquote(fptr,sym));
  328.  
  329.     /* restore the previous stack frame */
  330.     xlstack = oldstk;
  331.  
  332.     /* return the value */
  333.     return (val);
  334. }
  335.  
  336. /* rmlpar - read macro for '(' */
  337. NODE *rmlpar(args)
  338.   NODE *args;
  339. {
  340.     NODE ***oldstk,*fptr,*mch,*val;
  341.  
  342.     /* create a new stack frame */
  343.     oldstk = xlsave(&fptr,&mch,&val,(NODE **)NULL);
  344.  
  345.     /* get the file and macro character */
  346.     fptr = xlgetfile(&args);
  347.     mch = xlmatch(INT,&args);
  348.     xllastarg(args);
  349.  
  350.     /* make the return value */
  351.     val = consa(NIL);
  352.     rplaca(val,plist(fptr));
  353.  
  354.     /* restore the previous stack frame */
  355.     xlstack = oldstk;
  356.  
  357.     /* return the value */
  358.     return (val);
  359. }
  360.  
  361. /* rmrpar - read macro for ')' */
  362. NODE *rmrpar(args)
  363.   NODE *args;
  364. {
  365.     xlfail("misplaced right paren");
  366. }
  367.  
  368. /* rmsemi - read macro for ';' */
  369. NODE *rmsemi(args)
  370.   NODE *args;
  371. {
  372.     NODE ***oldstk,*fptr,*mch;
  373.     int ch;
  374.  
  375.     /* create a new stack frame */
  376.     oldstk = xlsave(&fptr,&mch,(NODE **)NULL);
  377.  
  378.     /* get the file and macro character */
  379.     fptr = xlgetfile(&args);
  380.     mch = xlmatch(INT,&args);
  381.     xllastarg(args);
  382.  
  383.     /* skip to end of line */
  384.     while ((ch = xlgetc(fptr)) != EOF && ch != '\n')
  385.     ;
  386.  
  387.     /* restore the previous stack frame */
  388.     xlstack = oldstk;
  389.  
  390.     /* return nil (nothing read) */
  391.     return (NIL);
  392. }
  393.  
  394. /* phexnumber - parse a hexidecimal number */
  395. LOCAL NODE *phexnumber(fptr)
  396.   NODE *fptr;
  397. {
  398.     long num;
  399.     int ch;
  400.  
  401.     num = 0L;
  402.     while ((ch = xlpeek(fptr)) != EOF) {
  403.     if (islower(ch)) ch = toupper(ch);
  404.     if (!isdigit(ch) && !(ch >= 'A' && ch <= 'F'))
  405.         break;
  406.     xlgetc(fptr);
  407.     num = num * 16L + (long)(ch <= '9' ? ch - '0' : ch - 'A' + 10);
  408.     }
  409.     return (cvfixnum((FIXNUM)num));
  410. }
  411.  
  412. /* plist - parse a list */
  413. LOCAL NODE *plist(fptr)
  414.   NODE *fptr;
  415. {
  416.     NODE ***oldstk,*val,*expr,*lastnptr;
  417.     NODE *nptr = NIL;
  418.  
  419.     /* create a new stack frame */
  420.     oldstk = xlsave(&val,&expr,(NODE **)NULL);
  421.  
  422.     /* increase the paren nesting level */
  423.     ++xlplevel;
  424.  
  425.     /* keep appending nodes until a closing paren is found */
  426.     lastnptr = NIL;
  427.     for (lastnptr = NIL; nextch(fptr) != ')'; lastnptr = nptr)
  428.  
  429.     /* get the next expression */
  430.     switch (readone(fptr,&expr)) {
  431.     case EOF:
  432.         badeof(fptr);
  433.     case TRUE:
  434.  
  435.         /* check for a dotted tail */
  436.         if (expr == s_dot) {
  437.  
  438.         /* make sure there's a node */
  439.         if (lastnptr == NIL)
  440.             xlfail("invalid dotted pair");
  441.  
  442.         /* parse the expression after the dot */
  443.         if (!xlread(fptr,&expr,TRUE))
  444.             badeof(fptr);
  445.         rplacd(lastnptr,expr);
  446.  
  447.         /* make sure its followed by a close paren */
  448.         if (nextch(fptr) != ')')
  449.             xlfail("invalid dotted pair");
  450.  
  451.         /* done with this list */
  452.         break;
  453.         }
  454.  
  455.         /* otherwise, handle a normal list element */
  456.         else {
  457.         nptr = consa(expr);
  458.         if (lastnptr == NIL)
  459.             val = nptr;
  460.         else
  461.             rplacd(lastnptr,nptr);
  462.         }
  463.         break;
  464.     }
  465.  
  466.     /* skip the closing paren */
  467.     xlgetc(fptr);
  468.  
  469.     /* decrease the paren nesting level */
  470.     --xlplevel;
  471.  
  472.     /* restore the previous stack frame */
  473.     xlstack = oldstk;
  474.  
  475.     /* return successfully */
  476.     return (val);
  477. }
  478.  
  479. /* pvector - parse a vector */
  480. LOCAL NODE *pvector(fptr)
  481.   NODE *fptr;
  482. {
  483.     NODE ***oldstk,*list,*expr,*val,*lastnptr;
  484.     NODE *nptr = NIL;
  485.     int len,ch,i;
  486.  
  487.     /* create a new stack frame */
  488.     oldstk = xlsave(&list,&expr,(NODE **)NULL);
  489.  
  490.     /* keep appending nodes until a closing paren is found */
  491.     lastnptr = NIL; len = 0;
  492.     for (lastnptr = NIL; (ch = nextch(fptr)) != ')'; lastnptr = nptr) {
  493.  
  494.     /* check for end of file */
  495.     if (ch == EOF)
  496.         badeof(fptr);
  497.  
  498.     /* get the next expression */
  499.     switch (readone(fptr,&expr)) {
  500.     case EOF:
  501.         badeof(fptr);
  502.     case TRUE:
  503.         nptr = consa(expr);
  504.         if (lastnptr == NIL)
  505.         list = nptr;
  506.         else
  507.         rplacd(lastnptr,nptr);
  508.         len++;
  509.         break;
  510.     }
  511.     }
  512.  
  513.     /* skip the closing paren */
  514.     xlgetc(fptr);
  515.  
  516.     /* make a vector of the appropriate length */
  517.     val = newvector(len);
  518.  
  519.     /* copy the list into the vector */
  520.     for (i = 0; i < len; ++i, list = cdr(list))
  521.     setelement(val,i,car(list));
  522.  
  523.     /* restore the previous stack frame */
  524.     xlstack = oldstk;
  525.  
  526.     /* return successfully */
  527.     return (val);
  528. }
  529.  
  530. /* pquote - parse a quoted expression */
  531. LOCAL NODE *pquote(fptr,sym)
  532.   NODE *fptr,*sym;
  533. {
  534.     NODE ***oldstk,*val,*p;
  535.  
  536.     /* create a new stack frame */
  537.     oldstk = xlsave(&val,(NODE **)NULL);
  538.  
  539.     /* allocate two nodes */
  540.     val = consa(sym);
  541.     rplacd(val,consa(NIL));
  542.  
  543.     /* initialize the second to point to the quoted expression */
  544.     if (!xlread(fptr,&p,TRUE))
  545.     badeof(fptr);
  546.     rplaca(cdr(val),p);
  547.  
  548.     /* restore the previous stack frame */
  549.     xlstack = oldstk;
  550.  
  551.     /* return the quoted expression */
  552.     return (val);
  553. }
  554.  
  555. /* pname - parse a symbol name */
  556. LOCAL NODE *pname(fptr,ch)
  557.   NODE *fptr; int ch;
  558. {
  559.     NODE *val,*type;
  560.     int i;
  561.  
  562.     /* get symbol name */
  563.     for (i = 0; ; xlgetc(fptr)) {
  564.     if (i < STRMAX)
  565.         buf[i++] = (islower(ch) ? toupper(ch) : ch);
  566.     if ((ch = xlpeek(fptr)) == EOF ||
  567.         ((type = tentry(ch)) != k_const &&
  568.              !(consp(type) && car(type) == k_nmacro)))
  569.         break;
  570.     }
  571.     buf[i] = 0;
  572.  
  573.     /* check for a number or enter the symbol into the oblist */
  574.     return (isnumber(buf,&val) ? val : xlenter(buf,DYNAMIC));
  575. }
  576.  
  577. /* tentry - get a readtable entry */
  578. LOCAL NODE *tentry(ch)
  579.   int ch;
  580. {
  581.     NODE *rtable;
  582.     rtable = getvalue(s_rtable);
  583.     if (!vectorp(rtable) || ch < 0 || ch >= getsize(rtable))
  584.     return (NIL);
  585.     return (getelement(rtable,ch));
  586. }
  587.  
  588. /* nextch - look at the next non-blank character */
  589. LOCAL int nextch(fptr)
  590.   NODE *fptr;
  591. {
  592.     int ch;
  593.  
  594.     /* return and save the next non-blank character */
  595.     while ((ch = xlpeek(fptr)) != EOF && isspace(ch))
  596.     xlgetc(fptr);
  597.     return (ch);
  598. }
  599.  
  600. /* checkeof - get a character and check for end of file */
  601. LOCAL int checkeof(fptr)
  602.   NODE *fptr;
  603. {
  604.     int ch;
  605.  
  606.     if ((ch = xlgetc(fptr)) == EOF)
  607.     badeof(fptr);
  608.     return (ch);
  609. }
  610.  
  611. /* badeof - unexpected eof */
  612. LOCAL badeof(fptr)
  613.   NODE *fptr;
  614. {
  615.     xlgetc(fptr);
  616.     xlfail("unexpected EOF");
  617. }
  618.  
  619. /* isnumber - check if this string is a number */
  620. int isnumber(str,pval)
  621.   char *str; NODE **pval;
  622. {
  623.     int dl,dr;
  624.     char *p;
  625.  
  626.     /* initialize */
  627.     p = str; dl = dr = 0;
  628.  
  629.     /* check for a sign */
  630.     if (*p == '+' || *p == '-')
  631.     p++;
  632.  
  633.     /* check for a string of digits */
  634.     while (isdigit(*p))
  635.     p++, dl++;
  636.  
  637.     /* check for a decimal point */
  638.     if (*p == '.') {
  639.     p++;
  640.     while (isdigit(*p))
  641.         p++, dr++;
  642.     }
  643.  
  644.     /* check for an exponent */
  645.     if ((dl || dr) && *p == 'E') {
  646.     p++;
  647.  
  648.     /* check for a sign */
  649.     if (*p == '+' || *p == '-')
  650.         p++;
  651.  
  652.     /* check for a string of digits */
  653.     while (isdigit(*p))
  654.         p++, dr++;
  655.     }
  656.  
  657.     /* make sure there was at least one digit and this is the end */
  658.     if ((dl == 0 && dr == 0) || *p)
  659.     return (FALSE);
  660.  
  661.     /* convert the string to an integer and return successfully */
  662.     if (*str == '+') ++str;
  663.     if (str[strlen(str)-1] == '.') str[strlen(str)-1] = 0;
  664.     *pval = (dr ? cvflonum(atof(str)) : cvfixnum(ICNV(str)));
  665.     return (TRUE);
  666. }
  667.  
  668. /* defmacro - define a read macro */
  669. defmacro(ch,type,fun)
  670.   int ch; NODE *type,*(*fun)();
  671. {
  672.     NODE *p;
  673.     p = consa(type);
  674.     setelement(getvalue(s_rtable),ch,p);
  675.     rplacd(p,cvsubr(fun,SUBR));
  676. }
  677.  
  678. /* callmacro - call a read macro */
  679. NODE *callmacro(fptr,ch)
  680.   NODE *fptr; int ch;
  681. {
  682.     NODE ***oldstk,*fun,*args,*val;
  683.  
  684.     /* create a new stack frame */
  685.     oldstk = xlsave(&fun,&args,(NODE **)NULL);
  686.  
  687.     /* get the macro function */
  688.     fun = cdr(getelement(getvalue(s_rtable),ch));
  689.  
  690.     /* create the argument list */
  691.     args = consa(fptr);
  692.     rplacd(args,consa(NIL));
  693.     rplaca(cdr(args),cvfixnum((FIXNUM)ch));
  694.  
  695.     /* apply the macro function to the arguments */
  696.     val = xlapply(fun,args);
  697.  
  698.     /* restore the previous stack frame */
  699.     xlstack = oldstk;
  700.  
  701.     /* return the result */
  702.     return (val);
  703. }
  704.  
  705. /* needsextension - determine if a filename needs an extension */
  706. int needsextension(name)
  707.   char *name;
  708. {
  709.     while (*name)
  710.     if (*name++ == '.')
  711.         return (FALSE);
  712.     return (TRUE);
  713. }
  714.  
  715. /* xlrinit - initialize the reader */
  716. xlrinit()
  717. {
  718.     NODE *rtable;
  719.     char *p;
  720.     int ch;
  721.  
  722.     /* create the read table */
  723.     rtable = newvector(256);
  724.     setvalue(s_rtable,rtable);
  725.  
  726.     /* initialize the readtable */
  727.     for (p = WSPACE; ch = *p++; )
  728.     setelement(rtable,ch,k_wspace);
  729.     for (p = CONST1; ch = *p++; )
  730.     setelement(rtable,ch,k_const);
  731.     for (p = CONST2; ch = *p++; )
  732.     setelement(rtable,ch,k_const);
  733.  
  734.     /* install the read macros */
  735.     defmacro('#', k_nmacro,rmhash);
  736.     defmacro('\'',k_tmacro,rmquote);
  737.     defmacro('"', k_tmacro,rmdquote);
  738.     defmacro('`', k_tmacro,rmbquote);
  739.     defmacro(',', k_tmacro,rmcomma);
  740.     defmacro('(', k_tmacro,rmlpar);
  741.     defmacro(')', k_tmacro,rmrpar);
  742.     defmacro(';', k_tmacro,rmsemi);
  743. }
  744.  
  745.